perm filename HAL.LST[HAL,HE] blob sn#207462 filedate 1976-03-19 generic text, type T, neo UTF8
	Test of ALAID	PALX 231	03/19/76  12:24:27	PAGE 1
	HAL PAL[HAL,HE]	PAGE 1 	

				COMMENT ⊗   VALID 00003 PAGES
				C REC  PAGE   DESCRIPTION
				C00001 00001
				C00002 00002	.TITLE  AL INTERPRETER
				C00006 00003	 program initialization
				C00016 ENDMK
					C⊗;
	AL INTERPRETER	PALX 231	03/19/76  12:24:27	PAGE 2
	HAL PAL[HAL,HE]	PAGE 2 	

					.TITLE  AL INTERPRETER
					
					;These need only be looked at during the first pass:
					    .IF1
					        .INSRT HALHED.PAL[HAL,HE]
					
						STSW  FLOAT,1	;1 => put in the floating-string conversions
						STSW  KERNEL,1	;1 => use the kernel
						STSW  SMALLB,1	;1 => use the small block routines
						STSW  ONMONS,1	;1 => put in condition monitors
						STSW  GRAPHS,1	;1 => put in graph structure
						STSW  MOVING,1	;1 => assume the servo is loaded too
						STSW  INTLOAD,1	;1 => put in the interpreter
						STSW  ALAID,1	;1 => put in the ALAID debugging stuff
						STSW  DETECT,0	;1 => put in the collision detector only
						STSW  MAP,0	;1 => put in mapping capablity.  Requires K2.
					
					        .INSRT K1DEF.PAL[11,SYS]
					    .ENDC
					
		014100			. = INTRP
					
					.INSRT HALIO.PAL[HAL,HE]
	AL INTERPRETER	PALX 231	03/19/76  12:24:27	PAGE 3
	HALIO PAL[HAL,HE]	PAGE 1 	

				COMMENT ⊗   VALID 00005 PAGES
				C REC  PAGE   DESCRIPTION
				C00001 00001
				C00002 00002	.SBTTL	Basic TTY input and output routines
				C00003 00003	 TTY output routines  TYPSTR, TYPDEC, TYPOCT, TYPCHR
				C00008 00004	 Macros:  OUTSTR, NUMOUT, ASCIE, CRLF, HALERR, ERRTRAP
				C00012 00005	 IOINIT, INSTR, system line buffers
				C00015 ENDMK
					C⊗;
	AL INTERPRETER	PALX 231	03/19/76  12:24:27	PAGE 4
	HALIO PAL[HAL,HE]	PAGE 2 	Basic TTY input and output routines

					.SBTTL	Basic TTY input and output routines
		014100			.EVEN
					
	AL INTERPRETER	PALX 231	03/19/76  12:24:27	PAGE 5
	HALIO PAL[HAL,HE]	PAGE 3 	Basic TTY input and output routines

					; TTY output routines  TYPSTR, TYPDEC, TYPOCT, TYPCHR
					
					;  Modified 5-Sep-74 by RF.  Originally written by KKP.
					
				COMMENT ⊗ Output a string, ending with a zero character. Pointer to
					start of string in R0.  Called in "simple" style. ⊗
					
	014100	010001			TYPSTR:	MOV R0,R1	;R1 ← LOC[STRING]
	014102	112100				MOVB (R1)+,R0	;R0 ← first byte of string
	014104	001404			TSLOOP:	BEQ TYPS1	;If null, exit now.
	014106	004767	000056			JSR PC,TYPCHR	;Type this one character
	014112	112100				MOVB (R1)+,R0	;R0 ← Next byte of string
	014114	001373				BNE TSLOOP	;If more to come, repeat.
	014116	000207			TYPS1:	RTS PC		;Done
					
					
				COMMENT ⊗ Routines to output numbers.  Argument in R0.  TYPDEC
				outputs in base 10, and TYPOCT in base 8.  Both use TYPDIG as a
				subroutine, putting the digit in R0.  TYPCHR is a general purpose
				character output routine.  It looks at OUTSW to see where to direct
					the output. ⊗
					
	014120	012767	000012	000020	TYPDEC:	MOV #12,RADIX	;To output in base 10
	014126	000404				BR TYPDIG	;Go type it.
	014130	012767	000010	000010	TYPOCT:	MOV #8,RADIX	;To output in base 8.
	014136	000400				BR TYPDIG	;Go type it.
	014140	010001			TYPDIG:	MOV R0,R1	;Need dividend in R1, with R0 clear.
	014142	005000				CLR R0		;Clear upper half of dividend.
	014144	071027				DIV (PC)+,R0	;Divide argument in R0, R1 by radix.
	014146	000012			RADIX:	12		;Starts out in decimal.
	014150	001404				BEQ TYPOUT	;If quotient zero, then can print.
	014152	010146				MOV R1,-(SP)	;Else stack quotient
	014154	004767	177760			JSR PC,TYPDIG	;Recursive call.
	014160	012601				MOV (SP)+,R1	;Unstack last quotient
	014162	062701	000060		TYPOUT:	ADD #'0,R1	;Form TTY code for digit
	014166	010100				MOV R1,R0	;Need argument for TYPCHR in R0.
	014170	005767	143576		TYPCHR:	TST OUTSW	;VT05 or console?
	014174	001423				BEQ TYPCH1	;
	014176	105767	163362			TSTB KBOS	;VT05: Is it available?
	014202	100404				BMI TYPCH2	;Yes.
					TYPCH3:
					    .IFDF KERNEL
		000001			    .IFNZ KERNEL
						SLEEP #1	;No.  Sleep a while, try again
						  .ARG #1
						    .LIF NB #1
	014204	012746	000001			      MOV #1,-(SP)
	014210	104014				104014
					    .ENDC
	AL INTERPRETER	PALX 231	03/19/76  12:24:27	PAGE 6
	HALIO PAL[HAL,HE]	PAGE 3.1 	Basic TTY input and output routines

					    .ENDC
	014212	000766				BR TYPCHR	;
	014214	110067	163346		TYPCH2:	MOVB R0,KBOR	;Output a byte to it.
	014220	022700	000012			CMP #12,R0	;Was it a line feed?
	014224	001014				BNE TYPRET	;If not that code, then done.
	014226	005000				CLR R0		;Otherwise, output 3 nulls.
	014230	004767	177734			JSR PC,TYPCHR	;
	014234	004767	177730			JSR PC,TYPCHR	;
	014240	000167	177724			JMP TYPCHR	;Direct jump; it will return to caller.
	014244	105767	143526		TYPCH1:	TSTB OREG	;Console:  Ready?
	014250	001355				BNE TYPCH3	;No.
	014252	110067	143520			MOVB R0,OREG	;Yes.  Output a byte to it.
	014256	000207			TYPRET:	RTS PC		;Return.
	AL INTERPRETER	PALX 231	03/19/76  12:24:27	PAGE 7
	HALIO PAL[HAL,HE]	PAGE 4 	Basic TTY input and output routines

					; Macros:  OUTSTR, NUMOUT, ASCIE, CRLF, HALERR, ERRTRAP
					
					       .MACRO OUTSTR B	;Type string starting at B.
						MOV R0,-(SP)	;Save R0.  Who knows what was happening in it?
						MOV R1,-(SP)	;Save R1.
						MOV #B,R0	;Load up the string to be output
						JSR PC,TYPSTR	;Call the string output utility routine.
						MOV (SP)+,R1	;Restore R1.
						MOV (SP)+,R0	;Restore R0.
					       .ENDM
					
					       .MACRO NUMOUT	;Type out the number in AC0 with CVG using OUTBUF
						MOV R0,-(SP)	;Save the registers
						MOV R1,-(SP)
						STF AC0,-(SP)
						STF AC1,-(SP)
						MOV #OUTBUF,R0	;Use OUTBUF to construct the string
						JSR PC,CVG	;Convert floating point number to asc
						LDF (SP)+,AC1   ;Restore the floating point registers
						LDF (SP)+,AC0
						MOV #OUTBUF,R0	;Set pointer for i/o routine
						JSR PC,TYPSTR	;Type out the number
						MOV (SP)+,R1	;Restore the registers
						MOV (SP)+,R0
					       .ENDM
					
					       .MACRO ASCIE STR
					       .ASCIZ STR
					       .EVEN
					       .ENDM
					
					       .MACRO	CRLF
						OUTSTR CRLFX	;Carriage return, line feed.
					       .ENDM
					
	014260	   015		
	014261	   012			CRLFX: .ASCIZ /
	014262	   000		
					/
					
				RUGMES:	ASCIE </π
				--ONLY DDT CAN HELP YOU NOW!
					π/>
	014263	   007		
	014264	   015		
	014265	   012			       .ASCIZ /π
	014266	   055		
	014267	   055		
	014270	   117		
	AL INTERPRETER	PALX 231	03/19/76  12:24:27	PAGE 8
	HALIO PAL[HAL,HE]	PAGE 4.1 	Basic TTY input and output routines

	014271	   116		
	014272	   114		
	014273	   131		
	014274	   040		
	014275	   104		
	014276	   104		
	014277	   124		
	014300	   040		
	014301	   103		
	014302	   101		
	014303	   116		
	014304	   040		
	014305	   110		
	014306	   105		
	014307	   114		
	014310	   120		
	014311	   040		
	014312	   131		
	014313	   117		
	014314	   125		
	014315	   040		
	014316	   116		
	014317	   117		
	014320	   127		
	014321	   041		
	014322	   015		
	014323	   012			--ONLY DDT CAN HELP YOU NOW!
	014324	   007		
	014325	   000		
					π/
		014326			       .EVEN
					
					ERRTRAP:
					; Pointer to message is on stack.  Print it, restore state, go to DDT
	014326	010046				MOV R0,-(SP)	;Save R0.
	014330	010146				MOV R1,-(SP)	;Save R1.
					    .IFDF KERNEL
		000001			    .IFNZ KERNEL
						EVWAIT CSLEVT	;Grab the console
						  .ARG CSLEVT
						    .LIF NB CSLEVT
	014332	016746	000052			      MOV CSLEVT,-(SP)
	014336	104010				104010
					    .ENDC
					    .ENDC
	014340	012700	014260			MOV #CRLFX,R0	;Move to new line
	014344	004767	177530			JSR PC,TYPSTR	;
	014350	016600	000006			MOV 6(SP),R0	;Type out message
	014354	004767	177520			JSR PC,TYPSTR	;
	AL INTERPRETER	PALX 231	03/19/76  12:24:27	PAGE 9
	HALIO PAL[HAL,HE]	PAGE 4.2 	Basic TTY input and output routines

	014360	012700	014263			MOV #RUGMES,R0	;Type out RUGMES
	014364	004767	177510			JSR PC,TYPSTR	;
					    .IFDF KERNEL
		000001			    .IFNZ KERNEL
						EVSIG CSLEVT	;Release the console
						  .ARG CSLEVT
						    .LIF NB CSLEVT
	014370	016746	000014			      MOV CSLEVT,-(SP)
	014374	104012				104012
					    .ENDC
					    .ENDC
	014376	012601				MOV (SP)+,R1	;Restore R1.
	014400	012600				MOV (SP)+,R0	;Restore R0.
	014402	012616				MOV (SP)+,(SP)	;put return address only on stack.
	014404	000003				BPT		;Breakpoint to DDT.
	014406	000207				RTS PC		;Return to calling point.
					
					PUTLOC LERRTRAP, ERRTRAP
		014410			        II==.
		014012			        .= LERRTRAP
	014012	014326			         ERRTRAP
		014410			       .=II
	AL INTERPRETER	PALX 231	03/19/76  12:24:27	PAGE 10
	HALIO PAL[HAL,HE]	PAGE 5 	Basic TTY input and output routines

					; IOINIT, INSTR, system line buffers
					
	014410	000000			CSLEVT:	0		;Console interlock event
					IOINIT:
					    .IFDF KERNEL
		000001			    .IFNZ KERNEL
						EVMAK		;
	014412	104004				104004
	014414	011667	177770			MOV (SP),CSLEVT	;
						EVSIG		;Make a console interlock event
						  .ARG 
						    .LIF NB 
						      MOV ,-(SP)
	014420	104012				104012
					    .ENDC
					    .ENDC
	014422	000207				RTS PC		;
					
				COMMENT ⊗ String byte pointer argument in R0.  A carriage return is
				assumed to be the activation character. A rubout is a deleting
				backspace character.  At the completion of this routine a null
				character is placed at the end of the input string.  R0 then points
				to the null character.  Registers used: R0 passes the argument, R1 is
					garbaged.  ⊗
					
	014424	005067	000154		INSTR:	CLR	CCNT		;RESET CHARACTER COUNT
	014430	105767	163124		IN2:  	TSTB	KBIS		;TEST IF KEYBOARD READY
	014434	001775				BEQ	.-4		;WAIT TILL IT IS
	014436	116701	163120			MOVB	KBIR,R1		;GET A CHARACTER
	014442	042701	177600			BIC     #177600,R1		;MASK OFF - MAKE IT 7 BITS
	014446	020127	000177			CMP	R1,#177		;COMPARE TO BS CHARACTER
	014452	001020				BNE	IN3		;SKIP IF ITS NOT
	014454	005767	000124			TST	CCNT		;CHECK IF ANY CHARACTERS IN BUFFER
	014460	001763				BEQ	IN2		;FORGET BACK SPACE IF NO CHAR.
	014462	005300				DEC     R0   		;REMOVE LAST CHARACTER IN BUFFER
	014464	005367	000114			DEC	CCNT		;DECREMENT CHARACTER COUNT
						OUTSTR  DBS		;PERFORM A DELETING BACKSPACE
	014470	010046				MOV R0,-(SP)	;Save R0.  Who knows what was happening in it?
	014472	010146				MOV R1,-(SP)	;Save R1.
	014474	012700	014606			MOV #DBS,R0	;Load up the string to be output
	014500	004767	177374			JSR PC,TYPSTR	;Call the string output utility routine.
	014504	012601				MOV (SP)+,R1	;Restore R1.
	014506	012600				MOV (SP)+,R0	;Restore R0.
	014510	000167	177714			JMP     IN2
	014514	020127	000015		IN3:	CMP	R1,#15		;COMPARE TO CR CHARACTER
	014520	001415				BEQ     IN4   		;CONTINUE READING IF ITS NOT A CR
	014522	020127	000040			CMP	R1,#40		;CHECK IF CHARACTER LEGAL
	014526	002740				BLT	IN2		;IGNOR IF IT IS
	014530	110120			    	MOVB	R1,(R0)+	;SAVE THE CHARACTER
	AL INTERPRETER	PALX 231	03/19/76  12:24:27	PAGE 11
	HALIO PAL[HAL,HE]	PAGE 5.1 	Basic TTY input and output routines

	014532	005267	000046		    	INC	CCNT		;INCREMENT CHARACTER COUNT
	014536	105767	163022		     	TSTB	KBOS		;ECHO THE CHARACTER
	014542	100375				BPL	.-4		;WAIT TILL TTY READY
	014544	110167	163016			MOVB	R1,KBOR		;WRITE THE CHARACTER
	014550	000167	177654			JMP	IN2		;CONTINUE READING
					IN4:  	CRLF			;IF IT IS A CR, TYPE A CR AND LF
						OUTSTR CRLFX	;Carriage return, line feed.
	014554	010046				MOV R0,-(SP)	;Save R0.  Who knows what was happening in it?
	014556	010146				MOV R1,-(SP)	;Save R1.
	014560	012700	014260			MOV #CRLFX,R0	;Load up the string to be output
	014564	004767	177310			JSR PC,TYPSTR	;Call the string output utility routine.
	014570	012601				MOV (SP)+,R1	;Restore R1.
	014572	012600				MOV (SP)+,R0	;Restore R0.
	014574	110120				MOVB	R1,(R0)+	;PUT A CR IN THE STRING
	014576	112710	000000			MOVB    #0,(R0)		;PUT IN A NULL CHARACTER
	014602	000207				RTS	PC		;RETURN
	014604	000000			CCNT:	0
	014606	   010		
	014607	   040		
	014610	   010		
	014611	   000			DBS:	.BYTE	10,40,10,0
					
					;System line buffers
					
		014736			INBUF:	.BLKW	42.
		015062			OUTBUF:	.BLKW	42.
	015062	014612			CURIN:	INBUF		;Current line pointer
	AL INTERPRETER	PALX 231	03/19/76  12:24:27	PAGE 12
	HAL PAL[HAL,HE]	PAGE 2.1 	Basic TTY input and output routines

					
		000000			.IFNZ MAP
					    .INSRT MAP.PAL[HAL,HE]
					.ENDC
					
					.INSRT LARGEB.PAL[HAL,HE]
	AL INTERPRETER	PALX 231	03/19/76  12:24:27	PAGE 13
	LARGEB PAL[HAL,HE]	PAGE 1 	Basic TTY input and output routines

				COMMENT ⊗   VALID 00004 PAGES
				C REC  PAGE   DESCRIPTION
				C00001 00001
				C00002 00002	.SBTTL Free storage management:  FRINIT
				C00004 00003	  GTFREE
				C00008 00004	  RLFREE
				C00011 ENDMK
					C⊗;
	AL INTERPRETER	PALX 231	03/19/76  12:24:27	PAGE 14
	LARGEB PAL[HAL,HE]	PAGE 2 	Free storage management:  FRINIT

					.SBTTL Free storage management:  FRINIT
					
					; Assembly variables
		004400			FREL = 4400		;Maximum = 40000 (IN WORDS!)
					
					; Free storage block
		015064			.EVEN
	015064	000000			LBEVT:	0		;Large block interlock event
	015066	015072			FREEPT:	FREEST
	015070	177777				-1		;Left bdry tag is negative.
	015072	011000			FREEST:	FREL*2		;Beginning of free storage.  Boundary tag.
		026070				.BLKW	FREL-2	;
	026070	011000			FREEND:	FREL*2		;End of free storage.  Boundary tag.
	026072	177777				-1		;Right bdry tag is negative.
					
					; Routine to initialize storage.  Need only call if you think
					;	storage has been munged, or you want to start over for
					;	some reason.
					FRINIT:	;Initialization of the large block allocator
						EVMAK		;Make a new large block interlock event
	026074	104004				104004
	026076	011667	166762			MOV (SP),LBEVT	;
						EVSIG 		;Give it one signal
						  .ARG 
						    .LIF NB 
						      MOV ,-(SP)
	026102	104012				104012
	026104	012767	011000	166760		MOV #FREL*2,FREEST	;Lower inner tag
	026112	012767	011000	177750		MOV #FREL*2,FREEND	;Upper inner tag
	026120	012767	015072	166740		MOV #FREEST,FREEPT	;Roving free pointer
	026126	026767	166736	177736		CMP FREEST-2,FREEND+2	;Do the two outer tags agree?
	026134	001001				BNE FRINER		;No.
	026136	000207				RTS PC			;Yes.  Return.
					FRINER:	HALERR FRINMS
	026140	012746	026150			MOV #FRINMS,-(SP)	;Push the message pointer.
	026144	004777	165642			JSR PC,@LERRTRAP	;No need to save registers.  This is done in ERRTRAP.
					FRINMS:	ASCIE /FRINIT FEARS FREE STORAGE HAS BEEN MUNGED/
	026150	   106		
	026151	   122		
	026152	   111		
	026153	   116		
	026154	   111		
	026155	   124		
	026156	   040		
	026157	   106		
	026160	   105		
	026161	   101		
	026162	   122		
	026163	   123		
	AL INTERPRETER	PALX 231	03/19/76  12:24:27	PAGE 15
	LARGEB PAL[HAL,HE]	PAGE 2.1 	Free storage management:  FRINIT

	026164	   040		
	026165	   106		
	026166	   122		
	026167	   105		
	026170	   105		
	026171	   040		
	026172	   123		
	026173	   124		
	026174	   117		
	026175	   122		
	026176	   101		
	026177	   107		
	026200	   105		
	026201	   040		
	026202	   110		
	026203	   101		
	026204	   123		
	026205	   040		
	026206	   102		
	026207	   105		
	026210	   105		
	026211	   116		
	026212	   040		
	026213	   115		
	026214	   125		
	026215	   116		
	026216	   107		
	026217	   105		
	026220	   104		
	026221	   000		
					       .ASCIZ /FRINIT FEARS FREE STORAGE HAS BEEN MUNGED/
		026222			       .EVEN
					
	AL INTERPRETER	PALX 231	03/19/76  12:24:27	PAGE 16
	LARGEB PAL[HAL,HE]	PAGE 3 	Free storage management:  FRINIT

					;  GTFREE
					
				  COMMENT ⊗
				  Routine to assign storage.  Amount of words requested in R0.
				 	Location of first word in block (not the boundary tag) returned
				 	in R0.
				   The boundary tag method described in Knuth I.2.5 is
				 	used.  Each block of storage has a boundary tag at
				 	each end, with identical contents:  The number
				 	of bytes in the whole area if available, and the opposite
				 	of that if busy.  Artificial busy areas above and below
				 	free storage.
					   ⊗
					
					GTFREE:	EVWAIT LBEVT	;Wait until we can enter critical section
						  .ARG LBEVT
						    .LIF NB LBEVT
	026222	016746	166636			      MOV LBEVT,-(SP)
	026226	104010				104010
	026230	010246				MOV R2,-(SP)	;Save R2 on stack.
	026232	006300				ASL R0		;Convert words to bytes
	026234	003004				BGT FR3		;Asked for negative number of words?
						HALERR FRMS1	;Yes.  Complain.
	026236	012746	026432			MOV #FRMS1,-(SP)	;Push the message pointer.
	026242	004777	165544			JSR PC,@LERRTRAP	;No need to save registers.  This is done in ERRTRAP.
	026246	062700	000004		FR3:	ADD #4, R0	;Need 2 extra words for boundary tags
	026252	016701	166610			MOV FREEPT, R1	;R1 ← running LOC[LTAG[*]]
	026256	020127	026070		FRTRY:	CMP R1,#FREEND	;Are we off the end of free storage?
	026262	101402				BLOS FR2	;No.
	026264	012701	015072			MOV #FREEST,R1	;Yes.  Reset pointer to beginning.
	026270	021100			FR2:	CMP (R1),R0	;Do we have enough room here?
	026272	002014				BGE FFOUND	;Yes
	026274	005711				TST (R1)	;No.  Is this area busy?  If so, its count is negative.
	026276	002002				BGE FRPOS	;No.
	026300	161101				SUB (R1),R1	;Yes.  R1 ← LOC[LTAG[next] by subtraction.
	026302	000401				BR  FR1
	026304	061101			FRPOS:	ADD (R1),R1	;R1 ← LOC[LTAG[next] by addition.
	026306	020167	166554		FR1:	CMP R1,FREEPT	;Have we cycled all through free storage
	026312	001361				BNE FRTRY	;No.  Try again.
						HALERR FRMS2	;Yes.  No room!
	026314	012746	026502			MOV #FRMS2,-(SP)	;Push the message pointer.
	026320	004777	165466			JSR PC,@LERRTRAP	;No need to save registers.  This is done in ERRTRAP.
	026324	001435			FFOUND:	BEQ FEXACT	;If 0, then exact fit.
	026326	010102				MOV R1,R2	;Divide the found block into FOUND and HOLE.
								;Thus, R1 = LOC[LTAG[FOUND]].
	026330	060002				ADD R0,R2	;R2 ← LOC[LTAG[HOLE]]
	026332	005400				NEG R0		;R0 ← negative (busy) count of FOUND.
	026334	010062	177776			MOV R0,-2(R2)	;RTAG[FOUND] ← new FOUND count.
	026340	010046				MOV R0,-(SP)	;Save R0.
	AL INTERPRETER	PALX 231	03/19/76  12:24:27	PAGE 17
	LARGEB PAL[HAL,HE]	PAGE 3.1 	Free storage management:  FRINIT

	026342	061100				ADD (R1),R0	;R0 ← new HOLE count.
	026344	010012				MOV R0,(R2)	;LTAG[HOLE] ← new HOLE count.
	026346	010267	166514			MOV R2,FREEPT	;Free pointer ← LOC[LTAG[HOLE]]
	026352	010102				MOV R1,R2	;
	026354	005742				TST -(R2)	;
	026356	061102				ADD (R1),R2	;R2 ← LOC[RTAG[HOLE]].
	026360	010012				MOV R0,(R2)	;RTAG[HOLE] ← new HOLE count.
	026362	012621				MOV (SP)+,(R1)+	;LTAG[FOUND] ← new FOUND count.
	026364	010100			FRRET:	MOV R1,R0	;R0 (result) ← LOC[LTAG[FOUND]] + 1.
	026366	016002	177776			MOV -2(R0),R2	;
	026372	005402				NEG R2		;R2 ← count of length
	026374	006202				ASR R2		; in words
	026376	162702	000002			SUB #2,R2	; without the boundary words
	026402	005021			FRRET1:	CLR (R1)+	;Clear out a word
	026404	077202				SOB R2,FRRET1	;Until done
	026406	012602				MOV (SP)+,R2	;Restore R2
						EVSIG LBEVT	;Can let others in now.
						  .ARG LBEVT
						    .LIF NB LBEVT
	026410	016746	166450			      MOV LBEVT,-(SP)
	026414	104012				104012
	026416	000207				RTS PC		;Done.
	026420	010102			FEXACT:	MOV R1,R2	;
	026422	061102				ADD (R1),R2	;R2 ← LOC[RTAG[FOUND]]
	026424	005421				NEG (R1)+	;LTAG[FOUND] ← new (busy) count.
	026426	005442				NEG -(R2)	;RTAG[FOUND] ← new (busy) count.
	026430	000755				BR FRRET	;Ready to return
					FRMS1:	ASCIE </GTFREE: R0 HAS BAD REQUEST WORD LENGTH/>
	026432	   107		
	026433	   124		
	026434	   106		
	026435	   122		
	026436	   105		
	026437	   105		
	026440	   072		
	026441	   040		
	026442	   122		
	026443	   060		
	026444	   040		
	026445	   110		
	026446	   101		
	026447	   123		
	026450	   040		
	026451	   102		
	026452	   101		
	026453	   104		
	026454	   040		
	026455	   122		
	026456	   105		
	AL INTERPRETER	PALX 231	03/19/76  12:24:27	PAGE 18
	LARGEB PAL[HAL,HE]	PAGE 3.2 	Free storage management:  FRINIT

	026457	   121		
	026460	   125		
	026461	   105		
	026462	   123		
	026463	   124		
	026464	   040		
	026465	   127		
	026466	   117		
	026467	   122		
	026470	   104		
	026471	   040		
	026472	   114		
	026473	   105		
	026474	   116		
	026475	   107		
	026476	   124		
	026477	   110		
	026500	   000		
					       .ASCIZ /GTFREE: R0 HAS BAD REQUEST WORD LENGTH/
		026502			       .EVEN
					FRMS2:	ASCIE /FREE STORAGE EXHAUSTED/
	026502	   106		
	026503	   122		
	026504	   105		
	026505	   105		
	026506	   040		
	026507	   123		
	026510	   124		
	026511	   117		
	026512	   122		
	026513	   101		
	026514	   107		
	026515	   105		
	026516	   040		
	026517	   105		
	026520	   130		
	026521	   110		
	026522	   101		
	026523	   125		
	026524	   123		
	026525	   124		
	026526	   105		
	026527	   104		
	026530	   000		
					       .ASCIZ /FREE STORAGE EXHAUSTED/
		026532			       .EVEN
					
	AL INTERPRETER	PALX 231	03/19/76  12:24:27	PAGE 19
	LARGEB PAL[HAL,HE]	PAGE 4 	Free storage management:  FRINIT

					;  RLFREE
					
					; Routine to release free storage.  R0=LOC[LTAG[BLOCK]] + 1.
					; Call the currently released block BLOCK, the adjacent one
					;	below LOW, and the adjacent one above HIGH.
					RLFREE:	EVWAIT LBEVT	;Wait for our turn in critical code.
						  .ARG LBEVT
						    .LIF NB LBEVT
	026532	016746	166326			      MOV LBEVT,-(SP)
	026536	104010				104010
	026540	014001				MOV -(R0),R1	;R1 ← LOC[LTAG[BLOCK]]
	026542	002404				BLT RL2		;Reasonable?
						HALERR RLMS1	;No.  Already available space.
	026544	012746	026666			MOV #RLMS1,-(SP)	;Push the message pointer.
	026550	004777	165236			JSR PC,@LERRTRAP	;No need to save registers.  This is done in ERRTRAP.
	026554	010001			RL2:	MOV R0,R1	;R1 ← LOC[LTAG[BLOCK]]
	026556	161000				SUB (R0),R0	;R0 ← LOC[LTAG[HIGH]]
	026560	021160	177776			CMP (R1),-2(R0)	;Do the two bdry tags agree?
	026564	001404				BEQ RL3		;
						HALERR RLMS2	;No.  Storage munged!!
	026566	012746	026736			MOV #RLMS2,-(SP)	;Push the message pointer.
	026572	004777	165214			JSR PC,@LERRTRAP	;No need to save registers.  This is done in ERRTRAP.
	026576	005411			RL3:	NEG (R1)	;Count is now positive in LTAG[BLOCK].
	026600	005761	177776			TST -2(R1)	;Is LOW available?
	026604	002411				BLT MERGR	;No.  Cannot merge left.
	026606	066111	177776			ADD -2(R1),(R1)	;Yes.  LTAG[BLOCK] ← New count
	026612	011160	177776			MOV (R1),-2(R0)	;RTAG[BLOCK] ← New count
	026616	010001				MOV R0,R1	;
	026620	166101	177776			SUB -2(R1),R1	;R1 ← LOC[LTAG[LOW]]
	026624	016011	177776			MOV -2(R0),(R1)	;LTAG[LOW] ← New count
								;At this point, call LOW&BLOCK = BLOCK.
	026630	005710			MERGR:	TST (R0)	;Is HIGH available?
	026632	002407				BLT RLRET	;No.  Prepare to return.
	026634	061011				ADD (R0),(R1)	;LTAG[BLOCK] ← New count
	026636	026700	166224			CMP FREEPT,R0	;Will FREEPT point into a vacuum?
	026642	001002				BNE RL1		;No.
	026644	010167	166216			MOV R1,FREEPT	;Yes.  Reset FREEPT ← LOC[LTAG[BLOCK]]
	026650	061000			RL1:	ADD (R0),R0	;R0 ← LOC[RTAG[HIGH]] + 1
								;At this point, call BLOCK&HIGH = BLOCK.
	026652	011160	177776		RLRET:	MOV (R1),-2(R0)	;RTAG[BLOCK] ← New count
						EVSIG LBEVT	;Let others into critical section now.
						  .ARG LBEVT
						    .LIF NB LBEVT
	026656	016746	166202			      MOV LBEVT,-(SP)
	026662	104012				104012
	026664	000207				RTS PC		;Done.
					
					RLMS1:	ASCIE /RLFREE: FREEING ALREADY AVAILABLE SPACE/
	026666	   122		
	AL INTERPRETER	PALX 231	03/19/76  12:24:27	PAGE 20
	LARGEB PAL[HAL,HE]	PAGE 4.1 	Free storage management:  FRINIT

	026667	   114		
	026670	   106		
	026671	   122		
	026672	   105		
	026673	   105		
	026674	   072		
	026675	   040		
	026676	   106		
	026677	   122		
	026700	   105		
	026701	   105		
	026702	   111		
	026703	   116		
	026704	   107		
	026705	   040		
	026706	   101		
	026707	   114		
	026710	   122		
	026711	   105		
	026712	   101		
	026713	   104		
	026714	   131		
	026715	   040		
	026716	   101		
	026717	   126		
	026720	   101		
	026721	   111		
	026722	   114		
	026723	   101		
	026724	   102		
	026725	   114		
	026726	   105		
	026727	   040		
	026730	   123		
	026731	   120		
	026732	   101		
	026733	   103		
	026734	   105		
	026735	   000		
					       .ASCIZ /RLFREE: FREEING ALREADY AVAILABLE SPACE/
		026736			       .EVEN
					RLMS2:	ASCIE /RLFREE: END TAGS DISAGREE/
	026736	   122		
	026737	   114		
	026740	   106		
	026741	   122		
	026742	   105		
	026743	   105		
	026744	   072		
	AL INTERPRETER	PALX 231	03/19/76  12:24:27	PAGE 21
	LARGEB PAL[HAL,HE]	PAGE 4.2 	Free storage management:  FRINIT

	026745	   040		
	026746	   105		
	026747	   116		
	026750	   104		
	026751	   040		
	026752	   124		
	026753	   101		
	026754	   107		
	026755	   123		
	026756	   040		
	026757	   104		
	026760	   111		
	026761	   123		
	026762	   101		
	026763	   107		
	026764	   122		
	026765	   105		
	026766	   105		
	026767	   000		
					       .ASCIZ /RLFREE: END TAGS DISAGREE/
		026770			       .EVEN
	AL INTERPRETER	PALX 231	03/19/76  12:24:27	PAGE 22
	HAL PAL[HAL,HE]	PAGE 2.2 	Free storage management:  FRINIT

					
					MAINBL:	PDBLK 210,S	;Makes a process descriptor for main process
						.IF NB S
						  .IF IDN <S>,<D>
						    .W.==UFPUSE+UDPUSE
						    .L.==66
						  .IFF
		100000				    .W.==UFPUSE
		000036				    .L.==36
						  .ENDC
						.IFF
						  .W.==0
						  .L.==0
						.ENDC
	026770	100000				.WORD .W.
	026772	000520				.WORD <UFEC-UST0>+.L.+<2*210>
		027012				.BLKB UIMAP-USKMIN
	027012	000376				.WORD 376
	027014	000376				.WORD 376
		027032				.BLKB UFEC-PDBR0
		027510				.BLKB 2*210+.L.
	027510	000167	025354		START:	JMP START1	;Put this in low core.  Eventually should be a switch.
					
		000001			.IFNZ ALAID		;The debugging package
		000001			    FLOAT==1		;uses floating output
					    .INSRT ALAID.PAL[HAL,HE]
	AL INTERPRETER	PALX 231	03/19/76  12:24:27	PAGE 23
	ALAID PAL[HAL,HE]	PAGE 1 	Free storage management:  FRINIT

				COMMENT ⊗   VALID 00013 PAGES
				C REC  PAGE   DESCRIPTION
				C00001 00001
				C00002 00002	  FILES, SETNAM
				C00003 00003	  Data structures:  Notes, note cells, message buffers
				C00005 00004	  GETNOTE, SNDNOTE, SERVER
				C00009 00005	  DOGTBUF, DOUSBUF, DORLBUF
				C00011 00006	  TREATMESSAGE, MAKANS, GETOFS, DOERR, SNDANS
				C00018 00007	  KTABLE, LOOKUP, ascie messages
				C00023 00008	  TACK, SKIPSP, SKIPOPT, DONOTHING
				C00025 00009	  DOGETVAL, DOSETVAL
				C00034 00010	  DOWAIT, DOSIGNAL
				C00039 00011	  DOSETNAM
				C00043 00012	  Driver for test of communications, ALINIT
				C00046 00013	  BUGS
				C00047 ENDMK
					C⊗;
	AL INTERPRETER	PALX 231	03/19/76  12:24:27	PAGE 24
	ALAID PAL[HAL,HE]	PAGE 2 	Free storage management:  FRINIT

					;  FILES, SETNAM
					
					.TITLE  Test of ALAID
					
					.IFNDF INTLOAD
					    DEBUG == 1
					.IFF
		000000			    DEBUG == 0
					.ENDC
					
		000001			KERNEL == 1
		000001			FLOAT == 1
					
		000000			.IFNZ DEBUG
					    .IF1
					        .INSRT HALHED.PAL[HAL,HE]
					        .INSRT K1DEF.PAL[11,SYS]
					    .ENDC
					
					    .=INTRP
					    .INSRT HALIO.PAL[HAL,HE]
					    .INSRT FLOAT.PAL[HAL,HE]
					    .INSRT LARGEB.PAL[HAL,HE]
					.ENDC
					
					TELL DEBUG
							TELL2 DEBUG,\DEBUG
							.PRINT /DEBUG = /
						.PRINT /0
					/
					TELL INTLOAD
							TELL2 INTLOAD,\INTLOAD
							.PRINT /INTLOAD = /
						.PRINT /1
					/
					
		000000			.IFZ DEBUG
					
					;  Special pseudo-ops
					
					SETNAM:	;Interpreter code
	027514	017464	000000	000026		MOV @IPC(R4),INTNAM(R4)
						BMPIPC		;
	027522	062764	000002	000000		ADD #2,IPC(R4)	;Bump IPC
						CCC		;Clear Condition Code
					;	CLR R0		;Clear condition code.  Not used right now.
	027530	000207				RTS PC		;Done
					.ENDC
	Test of ALAID	PALX 231	03/19/76  12:24:27	PAGE 25
	ALAID PAL[HAL,HE]	PAGE 3 	Free storage management:  FRINIT

					;  Data structures:  Notes, note cells, message buffers
					
					;  Notes from 10 to 11:
		000001			GETBUF == 1	;
		000002			USEBUF == 2	;
		000003			RELBUF == 3	;
					
					;  Notes from 11 to 10:
		000101			BUFALC == 101	;
		000102			TAKBUF == 102	;
					
					;  Offsets in notes:
		000002			ARG1 == 2
		000004			ARG2 == 4
					
					;  Offsets in message buffers:
		000000			MESID == 0	;
		000002			MESTYP == 2	;
		000001			    FROMTEN == 1	;
		000002			    FROMELF == 2	;
		000004			    REQUEST == 4	;
		000010			    ANSWER == 10	;
		000004			MESLTH == 4	;
		000006			MESBEG == 6	;
					
		000000			.IFZ DEBUG
		157000			    NOTB10 = 157000 ;  The notebox from 11 to the 10 (byte address)
		157020			    NOTB11 = 157020 ;  The notebox from 10 to the 11 (byte address)
					.IFF
					    NOTB10 = 100000 ;  The notebox from 11 to the 10 (byte address)
					    NOTB11 = 100020 ;  The notebox from 10 to the 11 (byte address)
					.ENDC
					
		000003			NOTSIZ == 3		;  In WORDS!
		000100			BUFSIZ == 100		;  In WORDS!
					
SETNAM+16	27532	3-37	NXTID	OUT OF PHASE
	027532	000000			NXTID: .WORD 0	;Always even
					
					;  Answer block:
		000000				II == 0
						XX ANSBUF	;Points to a buffer for the return answer
						   .IFDF ANSBUF
						       .IF1
						       .ERROR You are using ANSBUF in two ways!!!
						       .ENDC
						   .ENDC
		000000				    ANSBUF == II
		000002				    II == II+2
	Test of ALAID	PALX 231	03/19/76  12:24:27	PAGE 26
	ALAID PAL[HAL,HE]	PAGE 3.1 	Free storage management:  FRINIT

						XX ANPTR	;Initialized to point to the start of the message in ANSFUB
						   .IFDF ANPTR
						       .IF1
						       .ERROR You are using ANPTR in two ways!!!
						       .ENDC
						   .ENDC
		000002				    ANPTR == II
		000004				    II == II+2
						XX AGBUF	;Start of the question buffer
						   .IFDF AGBUF
						       .IF1
						       .ERROR You are using AGBUF in two ways!!!
						       .ENDC
						   .ENDC
		000004				    AGBUF == II
		000006				    II == II+2
						XX VALPTR	;The value to be used in the answer
						   .IFDF VALPTR
						       .IF1
						       .ERROR You are using VALPTR in two ways!!!
						       .ENDC
						   .ENDC
		000006				    VALPTR == II
		000010				    II == II+2
						XX GPHPTR	;The graph node to be used in the answer
						   .IFDF GPHPTR
						       .IF1
						       .ERROR You are using GPHPTR in two ways!!!
						       .ENDC
						   .ENDC
		000010				    GPHPTR == II
		000012				    II == II+2
						XX AGPTR	;Points to the current place in the question
						   .IFDF AGPTR
						       .IF1
						       .ERROR You are using AGPTR in two ways!!!
						       .ENDC
						   .ENDC
		000012				    AGPTR == II
		000014				    II == II+2
		000006				ABKSIZ == II/2	;Size of an answer block, in words.
					
					;  Interlock event
SETNAM+20	27534	3-50	ALEVT	OUT OF PHASE
	027534	000000			ALEVT:	.WORD 0
	Test of ALAID	PALX 231	03/19/76  12:24:27	PAGE 27
	ALAID PAL[HAL,HE]	PAGE 4 	Free storage management:  FRINIT

					;  GETNOTE, SNDNOTE, SERVER
					
SETNAM+22	27536	4-3	GETNOT	OUT OF PHASE
					GETNOTE:
					COMMENT ⊗ Returns the first note seen in a block pointed to by R0. ⊗
	027536	010246				MOV R2,-(SP)	;Save R2
SETNAM+24	27540	4-6	GTN2	OUT OF PHASE
					GTN2:	EVWAIT ALEVT	;Critical section
						  .ARG ALEVT
						    .LIF NB ALEVT
	027540	016746	177766			      MOV ALEVT,-(SP)
	027544	104010				104010
	027546	005767	127246			TST NOTB11	;Anything there?
	027552	001006				BNE GTN1	;Yes
						EVSIG ALEVT	;No.  Leave critical section
						  .ARG ALEVT
						    .LIF NB ALEVT
	027554	016746	177752			      MOV ALEVT,-(SP)
	027560	104012				104012
						SLEEP #100	;and sleep a while
						  .ARG #100
						    .LIF NB #100
	027562	012746	000100			      MOV #100,-(SP)
	027566	104014				104014
	027570	000762				BR  GTN2	;And try again
SETNAM+56	27572	4-12	GTN1	OUT OF PHASE
	027572	012700	000003		GTN1:	MOV #NOTSIZ,R0	;
	027576	010002				MOV R0,R2	;R2 ← Count